home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / Amiga / Applications / Musique / ays-t23d.lha / BoNuS @ thx.home.ml.org / SEA-THXR.LHA / thxplay.e < prev    next >
Text File  |  1998-03-01  |  8KB  |  305 lines
  1. OPT OSVERSION=37,PREPROCESS
  2.  
  3. MODULE 'gadtools',
  4.        'libraries/gadtools',
  5.        'exec/memory',
  6.        'exec/ports',
  7.        'exec/lists',
  8.        'exec/nodes',
  9.        'graphics/modeid',
  10.        'graphics/rastport',
  11.        'intuition/intuition',
  12.        'intuition/screens',
  13.        'intuition/gadgetclass',
  14.        'intuition/iobsolete',
  15.        'utility/tagitem',
  16.        'devices/inputevent',
  17.        'graphics/text'
  18.  
  19. MODULE 'diskfont'
  20.  
  21. MODULE    '*thxplayver',
  22.     'dos/dos',
  23.     'thx/thx-play',
  24.     'tools/file'
  25.  
  26. DEF    tmp[100]:STRING,
  27.     fname[100]:STRING
  28.  
  29. DEF    m,l,i
  30.  
  31.  
  32. /* GadToolsBox GUI: E source generated by SrcGen v0.5    */
  33. /*                 (by Wouter & Martin Kuchinka & Jason) */
  34.  
  35. ENUM ERROR_NONE,
  36.      ERROR_CONTEXT,
  37.      ERROR_GADGET,
  38.      ERROR_SCRN,
  39.      ERROR_VISUAL,
  40.      ERROR_GT,
  41.      ERROR_WINDOW,
  42.      ERROR_MENUS,
  43.      ERROR_PORT,
  44.      ERROR_DF,
  45.      ERROR_FONT
  46.  
  47. DEF infos:PTR TO gadget,
  48.     project0wnd:PTR TO window,
  49.     project0glist,
  50.     font=NIL,
  51.     scr=NIL:PTR TO screen,
  52.     visual=NIL,
  53.     offx,offy,
  54.     tattr:PTR TO textattr,
  55.     type,id,key,qual,item:PTR TO menuitem
  56.  
  57.  
  58. -> ***************************
  59. -> Start of templates section.
  60. -> (Return FALSE to quit the GUI.)
  61.  
  62.  
  63. -> Templates for window "project0":
  64.  
  65. PROC project0_CloseWindow()
  66.   -> Routine for "IDCMP_CLOSEWINDOW".
  67. ENDPROC FALSE
  68.  
  69. PROC gadget00_Clicked()
  70.   -> Routine when gadget "<" is clicked.
  71. ENDPROC TRUE
  72.  
  73. PROC gadget10_Clicked()
  74.   -> Routine when gadget "Play" is clicked.
  75.     thxPlay()
  76.     FOR i:=1 TO 64
  77.         Delay(2)
  78.         thxSetVolume(i)
  79.     ENDFOR
  80. ENDPROC TRUE
  81.  
  82. PROC gadget20_Clicked()
  83.   -> Routine when gadget "Stop" is clicked.
  84.     FOR i:=64 TO 0 STEP -1
  85.         WaitTOF()
  86.         thxSetVolume(i)
  87.     ENDFOR
  88.     thxFree()
  89. ENDPROC FALSE
  90.  
  91. PROC gadget30_Clicked()
  92.   -> Routine when gadget ">" is clicked.
  93. ENDPROC TRUE
  94.  
  95.  
  96. -> End of templates section.
  97. -> *************************
  98.  
  99.  
  100. PROC setupscreen()
  101.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN ERROR_GT
  102.   IF (diskfontbase:=OpenLibrary('diskfont.library',0))=NIL THEN RETURN ERROR_DF
  103.   font:=OpenDiskFont(tattr:=['topaz.font',8,0,$1]:textattr)
  104.   CloseLibrary(diskfontbase)
  105.   IF font=NIL THEN RETURN ERROR_FONT
  106.   IF (scr:=LockPubScreen(NIL))=NIL THEN RETURN ERROR_SCRN
  107.   IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN RETURN ERROR_VISUAL
  108.   offx:=scr.wborleft
  109.   offy:=scr.wbortop+scr.rastport.txheight+1
  110. ENDPROC
  111.  
  112. PROC closedownscreen()
  113.   IF visual THEN FreeVisualInfo(visual)
  114.   IF scr THEN UnlockPubScreen(NIL,scr)
  115.   IF font THEN CloseFont(font)
  116.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  117. ENDPROC
  118.  
  119. PROC openproject0window(port)
  120.   DEF g:PTR TO gadget
  121.   IF (g:=CreateContext({project0glist}))=NIL THEN RETURN ERROR_CONTEXT
  122.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  123.     [offx+8,offy+2,62,13,'<',tattr,0,PLACETEXT_IN,visual,{gadget00_Clicked}]:newgadget,
  124.     [GA_DISABLED,TRUE,
  125.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  126.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  127.     [offx+70,offy+2,62,13,'Play',tattr,1,PLACETEXT_IN,visual,{gadget10_Clicked}]:newgadget,
  128.     [TAG_END]))=NIL THEN RETURN ERROR_GADGET
  129.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  130.     [offx+132,offy+2,62,13,'Stop',tattr,2,PLACETEXT_IN,visual,{gadget20_Clicked}]:newgadget,
  131.     [TAG_END]))=NIL THEN RETURN ERROR_GADGET
  132.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  133.     [offx+194,offy+2,62,13,'>',tattr,3,PLACETEXT_IN,visual,{gadget30_Clicked}]:newgadget,
  134.     [GA_DISABLED,TRUE,
  135.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  136.   IF (project0wnd:=OpenWindowTagList(NIL,
  137.     [WA_LEFT,180,
  138.      WA_TOP,offy+45,
  139.      WA_WIDTH,offx+272,
  140.      WA_HEIGHT,offy+20,
  141.      WA_IDCMP,0,
  142.      WA_FLAGS,WFLG_SMART_REFRESH,
  143.      WA_TITLE,'Play module..',
  144.      WA_CUSTOMSCREEN,scr,
  145.      WA_MINWIDTH,67,
  146.      WA_MINHEIGHT,21,
  147.      WA_MAXWIDTH,$280,
  148.      WA_MAXHEIGHT,256,
  149.      WA_AUTOADJUST,TRUE,
  150.      WA_NEWLOOKMENUS,TRUE,
  151.      WA_GADGETS,project0glist,
  152.      TAG_END]))=NIL THEN RETURN ERROR_WINDOW
  153.   project0wnd.userport:=port
  154.   ModifyIDCMP(project0wnd,IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW)
  155.   project0wnd.userdata:=[{project0_CloseWindow},0,0,0,0]
  156.   DrawBevelBoxA(project0wnd.rport,offx+0,offy+0,268,18,
  157.     [GT_VISUALINFO,visual,TAG_END])
  158.   Gt_RefreshWindow(project0wnd,NIL)
  159. ENDPROC
  160.  
  161. PROC closeproject0window()
  162.   IF project0wnd
  163.     clearwinport(project0wnd)
  164.     IF project0wnd.userdata THEN Dispose(project0wnd.userdata)
  165.     CloseWindow(project0wnd)
  166.   ENDIF
  167.   IF project0glist THEN FreeGadgets(project0glist)
  168. ENDPROC
  169.  
  170. PROC clearwinport(win:PTR TO window)
  171.   DEF msg:PTR TO intuimessage, succ
  172.   IF win.userport
  173.     Forbid()
  174.     msg:=win.userport.msglist.head
  175.     WHILE succ:=msg.execmessage.ln.succ
  176.       IF msg.idcmpwindow=win
  177.         Remove(msg)
  178.         ReplyMsg(msg)
  179.       ENDIF
  180.       msg:=succ
  181.     ENDWHILE
  182.     win.userport:=NIL
  183.     ModifyIDCMP(win,0)
  184.     Permit()
  185.   ENDIF
  186. ENDPROC
  187.  
  188. PROC multiprocess(sig)
  189.   DEF win:PTR TO window
  190.   DEF running=TRUE, func:PTR TO LONG
  191.   WHILE running
  192.     win:=multiwait4message(sig)
  193.     SELECT type
  194.     CASE IDCMP_CLOSEWINDOW
  195.       func:=win.userdata
  196.       IF func THEN func:=func[]
  197.       IF func THEN running:=func()
  198.     CASE IDCMP_GADGETUP
  199.       func:=infos.userdata
  200.       IF func THEN running:=func()
  201.     CASE IDCMP_MENUPICK
  202.       WHILE infos<>MENUNULL
  203.         item:=ItemAddress(win.menustrip,infos)
  204.         func:=GTMENUITEM_USERDATA(item)
  205.         IF func THEN running:=func()
  206.       EXIT running=FALSE
  207.         infos:=item.nextselect AND $FFFF
  208.       ENDWHILE
  209.     CASE IDCMP_IDCMPUPDATE
  210.       func:=win.userdata
  211.       IF func THEN func:=func[1]
  212.       IF func THEN running:=func()
  213.     CASE IDCMP_INTUITICKS
  214.       func:=win.userdata
  215.       IF func THEN func:=func[2]
  216.       IF func THEN running:=func()
  217.     CASE IDCMP_MOUSEBUTTONS
  218.       func:=win.userdata
  219.       IF func THEN func:=func[3]
  220.       IF func THEN running:=func()
  221.     CASE IDCMP_VANILLAKEY
  222.       func:=win.userdata
  223.       IF func THEN func:=func[4]
  224.       IF func THEN running:=func()
  225.     ENDSELECT
  226.   ENDWHILE
  227. ENDPROC
  228.  
  229. PROC multiwait4message(port)
  230.   DEF win:PTR TO window,mes:PTR TO intuimessage
  231.   REPEAT
  232.     type:=0
  233.     IF mes:=Gt_GetIMsg(port)
  234.       win:=mes.idcmpwindow
  235.       type:=mes.class
  236.       SELECT type
  237.       CASE IDCMP_MENUPICK
  238.         infos:=mes.code
  239.       CASE IDCMP_GADGETUP
  240.         infos:=mes.iaddress
  241.         id:=infos.gadgetid
  242.       CASE IDCMP_VANILLAKEY
  243.         key:=mes.code
  244.         qual:=mes.qualifier AND $FFFF
  245.       CASE IDCMP_MOUSEBUTTONS
  246.         qual:=mes.qualifier AND $FFFF
  247.       CASE IDCMP_REFRESHWINDOW
  248.         Gt_BeginRefresh(win)
  249.         Gt_EndRefresh(win,TRUE)
  250.         type:=0
  251.       ENDSELECT
  252.       Gt_ReplyIMsg(mes)
  253.     ELSE
  254.       WaitPort(port)
  255.     ENDIF
  256.   UNTIL type
  257. ENDPROC win
  258.  
  259. PROC reporterr(er)
  260.   DEF erlist:PTR TO LONG
  261.   IF er
  262.     erlist:=['get context',
  263.              'create gadget',
  264.              'lock/open screen',
  265.              'get visual infos',
  266.              'open "gadtools.library" v37+',
  267.              'open window',
  268.              'create menus',
  269.              'create port',
  270.              'open "diskfont.library"',
  271.              'open font']
  272.     EasyRequestArgs(0,[20,0,0,'Could not \s!','OK'],0,[erlist[er-1]])
  273.   ENDIF
  274. ENDPROC er
  275.  
  276. PROC main() HANDLE
  277.   DEF err=ERROR_NONE,port=NIL
  278.  
  279.     IF InStr(arg,'"',0)>=0
  280.         MidStr(tmp,arg,1,StrLen(arg)-2)
  281.          StrCopy(fname,tmp,ALL)
  282.     ELSE
  283.         StrCopy(fname,arg,ALL)
  284.     ENDIF
  285.     WriteF('\nTHXPlay v1.4 by Dr. Ice SEA\n')
  286.     IF FileLength(fname)<10
  287.         WriteF('\nBad THX file, or file not found...\n')
  288.         CleanUp(0)
  289.     ENDIF
  290.     m,l:=readfile(fname,0,2)
  291.     thxInit(m)
  292.     thxSetVolume(0)
  293.  
  294.  
  295.   IF (port:=CreateMsgPort())=NIL THEN Raise(ERROR_PORT)
  296.   IF (err:=setupscreen())<>ERROR_NONE THEN Raise(err)
  297.   reporterr(openproject0window(port))
  298.   multiprocess(port)
  299.   closeproject0window()
  300. EXCEPT DO
  301.   IF port THEN DeleteMsgPort(port)
  302.   closedownscreen()
  303.   reporterr(err)
  304. ENDPROC
  305.